home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / misc.swg / 0087_Misc Utilities.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  11.0 KB  |  342 lines
  1. UNIT Utils;                {  Misc Utilities Last Updates  Nov 01/93       }
  2.                         {  Copyright (C) 1992,93 Greg Estabrooks        }
  3.  
  4. INTERFACE
  5. { *********************************************************************}
  6. USES
  7.     CRT,KeyIO,DOS;
  8.  
  9. CONST
  10.       FpuType :ARRAY[0..3] OF STRING[10] =('None','8087','80287','80387');
  11.       CPU     :ARRAY[0..3] Of STRING[13] =('8088/V20','80286',
  12.                                           '80386/80486','80486');
  13. CONST                                   {  Define COM port Addresses    }
  14.      ComPort :ARRAY[1..4] Of WORD = ($3F8,$2F8,$3E8,$2E8);
  15.  
  16. CONST
  17.      Warm :WORD = 0000;         { Predefined value for warm boot.       }
  18.      Cold :WORD = 0001;         { Predefined value for cold boot.       }
  19.  
  20. VAR
  21.     BiosDate  :ARRAY[0..7] of CHAR Absolute $F000:$FFF5;
  22.     EquipFlag :WORD Absolute $0000:$0410;
  23.     CompID    :BYTE Absolute $F000:$FFFE;
  24.  
  25. FUNCTION CoProcessorExist :BOOLEAN;
  26. FUNCTION NumPrinters :WORD;
  27. FUNCTION GameIOAttached :BOOLEAN;
  28. FUNCTION NumSerialPorts :INTEGER;
  29. FUNCTION NumDisketteDrives :INTEGER;
  30. FUNCTION InitialVideoMode :INTEGER;
  31. PROCEDURE Noise(Pitch, Duration :INTEGER);
  32. FUNCTION  Time :STRING;
  33. FUNCTION  WeekDate :STRING;
  34. FUNCTION DayOfWeek( Month, Day, Year :WORD ) :BYTE; {  Returns 1-7 }
  35. FUNCTION PrinterOK :BOOLEAN;
  36. FUNCTION AdlibCard :BOOLEAN;
  37. FUNCTION TrueDosVer :WORD;
  38. PROCEDURE SetPrtScr( On_OFF :BOOLEAN );
  39. FUNCTION CpuType :WORD;
  40. PROCEDURE IdePause;
  41. FUNCTION RingDetect( CPort :WORD) :BOOLEAN;
  42. function DetectOs2: Boolean;
  43. FUNCTION HiWord( Long :LONGINT ) :WORD;
  44.                       { Routine to return high word of a LongInt.       }
  45. FUNCTION LoWord( Long :LONGINT ) :WORD;
  46.                       { Routine to return low word of a LongInt.        }
  47. FUNCTION Running4DOS : Boolean;
  48. PROCEDURE Reboot( BootCode :WORD );
  49.                       { Routine to reboot system according to boot code.}
  50.  
  51.  
  52. FUNCTION GetChar( X,Y :WORD; VAR Attrib:BYTE ) :CHAR;
  53.  
  54. IMPLEMENTATION
  55. { *********************************************************************}
  56. FUNCTION CoProcessorExist :BOOLEAN;
  57. BEGIN
  58.   CoProcessorExist := (EquipFlag And 2) = 2;
  59. END;
  60.  
  61. FUNCTION NumPrinters :WORD;
  62. BEGIN
  63.   NumPrinters := EquipFlag Shr 14;
  64. END;
  65.  
  66. FUNCTION GameIOAttached :BOOLEAN;
  67. BEGIN
  68.   GameIOAttached := (EquipFlag And $1000) = 1;
  69. END;
  70.  
  71. FUNCTION NumSerialPorts :INTEGER;
  72. BEGIN
  73.   NumSerialPorts := (EquipFlag Shr 9) And $07;
  74. END;
  75.  
  76. FUNCTION NumDisketteDrives :INTEGER;
  77. BEGIN
  78.   NumDisketteDrives := ((EquipFlag And 1) * (1+(EquipFlag Shr 6) And $03));
  79. END;
  80.  
  81. FUNCTION InitialVideoMode :INTEGER;
  82. BEGIN
  83.   InitialVideoMode := (EquipFlag Shr 4) And $03;
  84. END;
  85.  
  86. PROCEDURE Noise( Pitch, Duration :INTEGER );
  87. BEGIN
  88.   Sound(Pitch);
  89.   Delay(Duration);
  90.   NoSound;
  91. END;
  92.  
  93. Function Time : String;
  94. VAR
  95.   Hour,Min,Sec :STRING[2];
  96.   H,M,S,T      :WORD;
  97.  
  98. BEGIN
  99.     GetTime(H,M,S,T);
  100.     Str(H,Hour);
  101.     Str(M,Min);
  102.     Str(S,Sec);
  103.     If S < 10 Then
  104.       Sec := '0' + Sec;
  105.     If M < 10 Then
  106.         Min := '0' + Min;
  107.     If H > 12 Then
  108.     BEGIN
  109.        Str(H - 12, Hour);
  110.        IF Length(Hour) = 1 Then Hour := ' ' + Hour;
  111.           Time := Hour + ':' + Min + ':' + Sec+' pm'
  112.     END
  113.     ELSE
  114.       BEGIN
  115.        If H = 0 Then
  116.          Time :=   '12:' + Min + ':' + Sec + ' am'
  117.        ELSE
  118.          Time := Hour +':'+Min+':'+Sec+' am';
  119.       END;
  120.     If H = 12 Then
  121.        Time := Hour + ':' + Min + ':' + Sec + ' pm';
  122. END;
  123.  
  124. FUNCTION WeekDate :STRING;
  125. TYPE
  126.   WeekDays = Array[0..6]  Of STRING[9];
  127.   Months   = Array[1..12] Of STRING[9];
  128.  
  129. CONST
  130.     DayNames   : WeekDays  = ('Sunday','Monday','Tuesday','Wednesday',
  131.                               'Thursday','Friday','Saturday');
  132.     MonthNames : Months    = ('January','February','March','April','May',
  133.                               'June','July','August','September',
  134.                               'October','November','December');
  135. VAR
  136.          Y,
  137.          M,
  138.          D,
  139.          DayOfWeek :WORD;
  140.          Year      :STRING;
  141.          Day       :STRING;
  142.  
  143. BEGIN
  144.     GetDate(Y,M,D,DayofWeek);
  145.     Str(Y,Year);
  146.     Str(D,Day);
  147.     WeekDate := DayNames[DayOfWeek] + ' ' + MonthNames[M] + ' ' + Day+ ', '
  148.      + Year;
  149. END;
  150.  
  151. FUNCTION DayOfWeek( Month, Day, Year :WORD ) :BYTE;
  152. VAR ivar1, ivar2    : Integer;
  153. BEGIN
  154.   IF (Day > 0) AND (Day < 32) AND (Month > 0) AND (Month < 13)
  155.     THEN
  156.         BEGIN
  157.           ivar1 := ( Year MOD 100 );
  158.           ivar2 := Day + ivar1 + ivar1 DIV 4;
  159.           CASE Month OF
  160.               4, 7    : ivar1 := 0;
  161.               1, 10   : ivar1 := 1;
  162.               5       : ivar1 := 2;
  163.               8       : ivar1 := 3;
  164.               2,3,11  : ivar1 := 4;
  165.               6       : ivar1 := 5;
  166.               9,12    : ivar1 := 6;
  167.           END; {case}
  168.           ivar2 := ( ivar1 + ivar2 ) MOD 7;
  169.           IF ( ivar2 = 0 ) THEN ivar2 := 7;
  170.           END {IF}
  171.     ELSE
  172.         ivar2 := 0;
  173.     DayOfWeek := BYTE( ivar2 );
  174. END;
  175.  
  176. FUNCTION PrinterOK :BOOLEAN;
  177.                 {  Determine whether printer is on or off line         }
  178. BEGIN
  179.   If (Port[$379]) And (16) <> 16 Then
  180.      PrinterOK := False
  181.   Else
  182.      PrinterOK := True;
  183. END;
  184.  
  185. FUNCTION AdlibCard :BOOLEAN;
  186.         {  Routine to determine if a Adlib compatible card is installed }
  187. VAR
  188.         Val1,Val2 :BYTE;
  189. BEGIN
  190.   Port[$388] := 4;                {  Write 60h to register 4              }
  191.   Delay(3);                        {  Which resets timer 1 and 2           }
  192.   Port[$389] := $60;
  193.   Delay(23);
  194.   Port[$388] := 4;                {  Write 80h to register 4              }
  195.   Delay(3);                     {  Which enables interrupts             }
  196.   Port[$389] := $80;
  197.   Delay(23);
  198.   Val1 := Port[$388];                {  Read status byte                     }
  199.   Port[$388] := 2;                {  Write ffh to register 2              }
  200.   Delay(3);                     {  Which is also Timer 1                }
  201.   Port[$389] := $FF;
  202.   Delay(23);
  203.   Port[$388] := 4;                {  Write 21h to register 4              }
  204.   Delay(3);                        {  Which will Start Timer 1             }
  205.   Port[$389] := $21;
  206.   Delay(85);                        {  wait 85 microseconds                 }
  207.   Val2 := Port[$388];                {  read status byte                     }
  208.   Port[$388] := 4;                {  Repeat the first to steps            }
  209.   Delay(3);                        {  Which will reset both Timers         }
  210.   Port[$389] := $60;
  211.   Delay(23);
  212.   Port[$388] := 4;
  213.   Delay(3);
  214.   Port[$389] := $80;                        {  Now test the status bytes saved }
  215.   If ((Val1 And $E0) = 0) And ((Val2 And $E0) = $C0) Then
  216.      AdlibCard := True                        {  Card was found               }
  217.   Else
  218.      AdlibCard := False;                {  No Card Installed            }
  219. END;
  220.  
  221. FUNCTION TrueDosVer :WORD; ASSEMBLER;
  222.                 {  Returns true Dos Version. Not affected by Setver     }
  223. ASM
  224.   Mov AX,$3306                  {  get true dos ver                     }
  225.   Int $21                        {  Call Dos                             }
  226.   Mov AX,BX                     {  Return proper results                }
  227.  
  228.         {  DL = Revision Number                                         }
  229.         {  DH = V Flags, 8h = Dos in ROM,  10h Dos in HMA               }
  230. END;{TrueDosVer}
  231.  
  232. PROCEDURE SetPrtScr( On_OFF :BOOLEAN );
  233.                 {  Routine to Enable or disable Print screen key   }
  234. BEGIN
  235.   If On_OFF Then                {  Turn it on                      }
  236.     Mem[$0050:0000] := 0
  237.   Else
  238.     Mem[$0050:0000] := 1;        {  Turn it off                     }
  239. END;
  240.  
  241. FUNCTION CpuType :WORD; ASSEMBLER;
  242.                  {  Returns a value depending on the type of CPU        }
  243.                  {          0 = 8088/V20 or compatible                  }
  244.                  {          1 = 80286    2 = 80386/80486+               }
  245. ASM
  246.   Xor DX,DX                             {  Clear DX                     }
  247.   Push DX
  248.   PopF                                  {  Clear Flags                  }
  249.   PushF
  250.   Pop AX                                {  Load Cleared Flags           }
  251.   And AX,$0F000                         {  Check hi bits for F0h        }
  252.   Cmp AX,$0F000
  253.   Je @Quit                              {  Quit if 8088                 }
  254.   Inc DX
  255.   Mov AX,$0F000                         {  Now Check For 80286          }
  256.   Push AX
  257.   PopF
  258.   PushF
  259.   Pop AX
  260.   And AX,$0F000                         {  If The top 4 bits aren't set }
  261.   Jz @Quit                              {  Its a 80286+                 }
  262.   Inc DX                                {  Else its a 80386 or better   }
  263. @Quit:
  264.   Mov AX,DX                             {  Return Result in AX          }
  265. END;{CpuType}
  266.  
  267. procedure idepause;
  268. begin
  269.   gotoxy(1,25);
  270.   write('Press any key to return to IDE');
  271.   pausekey;
  272. end;
  273.  
  274. FUNCTION RingDetect( CPort :WORD) :BOOLEAN;
  275.                              {  Routine to detect whether or not the    }
  276.                              {  phone is ringing by checking the comport}
  277. BEGIN
  278.   RingDetect := ODD( PORT[CPort] SHR 6 );
  279. END;
  280.  
  281. function DetectOs2: Boolean;
  282. begin
  283.   { if you use Tpro, then write Hi(TpDos.DosVersion) }
  284.   DetectOs2 := (Lo(Dos.DosVersion) > 10);
  285. end;
  286.  
  287. FUNCTION HiWord( Long :LONGINT ) :WORD; ASSEMBLER;
  288.                       { Routine to return high word of a LongInt.       }
  289. ASM
  290.   Mov AX,Long.WORD[2]              { Move High word into AX.            }
  291. END;
  292.  
  293. FUNCTION LoWord( Long :LONGINT ) :WORD; ASSEMBLER;
  294.                       { Routine to return low word of a LongInt.        }
  295. ASM
  296.   Mov AX,Long.WORD[0]              { Move low word into AX.             }
  297. END;
  298.  
  299. FUNCTION Running4DOS : Boolean;
  300. VAR Regs : Registers;
  301. begin
  302.   With Regs do
  303.      begin
  304.        ax := $D44D;
  305.        bx := $00;
  306.      end;
  307.   Intr ($2F, Regs);
  308.   if Regs.ax = $44DD then Running4DOS := TRUE
  309.      else Running4DOS := FALSE
  310. end;
  311.  
  312. PROCEDURE Reboot( BootCode :WORD );
  313.                       { Routine to reboot system according to boot code.}
  314.                       { Also flushes all DOS buffers.                   }
  315.                       { NOTE: Doesn't update directory entries.         }
  316. BEGIN
  317.   Inline(
  318.           $BE/$0D/              { MOV   AH,0Dh                          }
  319.           $CD/$21/              { INT   21h                             }
  320.           $FB/                  { STI                                   }
  321.           $B8/Bootcode/         { MOV   AX,BootCode                     }
  322.           $8E/$D8/              { MOV   DS,AX                           }
  323.           $B8/$34/$12/          { MOV   AX,1234h                        }
  324.           $A3/$72/$04/          { MOV   [0472h],AX                      }
  325.           $EA/$00/$00/$FF/$FF); { JMP   FFFFh:0000h                     }
  326. END;
  327.  
  328.  
  329. FUNCTION GetChar( X,Y :WORD; VAR Attrib:BYTE ) :CHAR;
  330.                       { Retrieves the character and attribute of        }
  331.                       { coordinates X,Y.                                }
  332. VAR
  333.    Ofs :WORD;
  334. BEGIN
  335.   Ofs := ((Y-1) * 160) + ((X SHL 1) - 1);
  336.   Attrib := MEM[$B800:Ofs];
  337.   GetChar := CHR( MEM[$B800:Ofs-1] );
  338. END;
  339.  
  340.  
  341. BEGIN
  342. END.